* CPZERO -- Poke a codepage byte into a database header
* Copyright Microsoft Corp, 1993-2001
*
* Usage: 
*    DO CPZERO WITH dbfname                     && marks the database with codepage 0 (i.e., no codepage)
* 
*    DO CPZERO WITH dbfname, codepage_number    && marks the database with specified codepage
*
* Some common valid numbers are:
*   Windows            1252
*   DOS                 437
*   International DOS   850
*

PARAMETER m.fname, m.cpbyte
IF SET("TALK") = "ON"
   SET TALK OFF
   m.mtalk = "ON"
ELSE
   m.mtalk = "OFF"
ENDIF   

#define C_TOTAL 29     && total code page numbers supported

IF PARAMETERS() < 2
   m.cpbyte = 0
ENDIF   

PRIVATE m.mtalk, m.vuename

#define c_buf_size 32

#define c_noopen   1
#define c_badbyte  2
#define c_notfox   3
#define c_maxerror 4

#DEFINE c_notopened_LOC 	"The table could not be opened."
#DEFINE c_invalid_page_LOC	"Invalid code page specified."
#DEFINE c_NotFoxTable_LOC	"Not a FoxPro table."

#DEFINE c_OpenTable_LOC		"Table:"

m.vuename = ""

DECLARE error_array[c_maxerror]
error_array[c_noopen] = c_notopened_LOC
error_array[c_badbyte] = c_invalid_page_LOC
error_array[c_notfox] = c_NotFoxTable_LOC

DO setup
DO main
DO cleanup

PROCEDURE setup
m.vuename = SYS(2023)+"\"+SYS(3)+".VUE"
CREATE VIEW (m.vuename)


PROCEDURE cleanup
IF FILE(m.vuename)
   SET VIEW TO (m.vuename)
   DELETE FILE (m.vuename)
ENDIF   
SET TALK &mtalk

PROCEDURE main
PRIVATE m.fp_in, m.buf, m.found_one, m.i, m.outbyte

* Set up table of code pages and DBF bytes numbers
DIMENSION cpnums[C_TOTAL,2] 
cpnums[ 1,1] = 437		&& MS-DOS, U.S.A.
cpnums[ 1,2] = 1
cpnums[ 2,1] = 850		&& MS-DOS, International
cpnums[ 2,2] = 2
cpnums[ 3,1] = 1252		&& Windows, U.S.A & West European
cpnums[ 3,2] = 3
cpnums[ 4,1] = 10000	&& Macintosh, U.S.A.
cpnums[ 4,2] = 4
cpnums[ 5,1] = 852		&& MS-DOS, East European
cpnums[ 5,2] = 100
cpnums[ 6,1] = 866		&& MS-DOS, Russian
cpnums[ 6,2] = 101
cpnums[ 7,1] = 865		&& MS-DOS, Nordic
cpnums[ 7,2] = 102
cpnums[ 8,1] = 861		&& MS-DOS, Iceland
cpnums[ 8,2] = 103
cpnums[ 9,1] = 895		&& MS-DOS, Kamenicky (Czech)
cpnums[ 9,2] = 104
cpnums[10,1] = 620		&& MS-DOS, Mazovia (Polish)
cpnums[10,2] = 105
cpnums[11,1] = 737		&& MS-DOS, Greek
cpnums[11,2] = 106
cpnums[12,1] = 857		&& MS-DOS, Turkey
cpnums[12,2] = 107
cpnums[13,1] = 863		&& MS-DOS, Canada
cpnums[13,2] = 108
cpnums[14,1] = 950		&& Windows, Traditional Chinese
cpnums[14,2] = 120
cpnums[15,1] = 949		&& Windows, Korean (Hangul)
cpnums[15,2] = 121
cpnums[16,1] = 936		&& Windows, Simplified Chinese
cpnums[16,2] = 122
cpnums[17,1] = 932		&& Windows, Japanese (Shift-jis)
cpnums[17,2] = 123
cpnums[18,1] = 874		&& Windows, Thai
cpnums[18,2] = 124
cpnums[19,1] = 10007	&& Macintosh, Russian
cpnums[19,2] = 150
cpnums[20,1] = 10029	&& Macintosh, East European
cpnums[20,2] = 151
cpnums[21,1] = 10006	&& Macintosh, Greek
cpnums[21,2] = 152
cpnums[22,1] = 1250		&& Windows, East European
cpnums[22,2] = 200
cpnums[23,1] = 1251		&& Windows, Russian
cpnums[23,2] = 201
cpnums[24,1] = 1253		&& Windows, Greek
cpnums[24,2] = 203
cpnums[25,1] = 1254		&& Windows, Turkish
cpnums[25,2] = 202
cpnums[26,1] = 1255		&& Windows, Hebrew (Only supported on Hebrew OS)
cpnums[26,2] = 125
cpnums[27,1] = 1256		&& Windows, Arabic (Only supported on Arabic OS)
cpnums[27,2] = 126
cpnums[28,1] = 1257		&& Windows, Baltic
cpnums[28,2] = 204
cpnums[29,1] = 0		&& No codepage mark.
cpnums[29,2] = 0

IF EMPTY(m.fname)
   m.fname = getfile("DBF|SCX|VCX|FRX|LBX|MNX",c_OpenTable_LOC)
ENDIF
IF !EMPTY(m.fname)
   CLOSE DATABASES
   m.outbyte = m.cpbyte
   m.found_one = .F.
   FOR m.i = 1 TO C_TOTAL
      IF m.cpbyte = cpnums[m.i,1]
         m.outbyte = cpnums[m.i,2]
         m.found_one = .T.
         EXIT
      ENDIF
   ENDFOR
   IF m.found_one
      m.cpbyte = m.outbyte
   ELSE
      * Was it a valid DBF byte if it wasn't a valid code page?
      FOR m.i = 1 TO C_TOTAL
         IF m.cpbyte = cpnums[m.i,2]
            m.found_one = .T.
         ENDIF
      ENDFOR
      IF !m.found_one
         DO errormsg WITH c_badbyte
         RETURN TO cpzero
      ENDIF
   ENDIF
   
   IF FILE(m.fname)
       m.fp_in = FOPEN(m.fname,2)
       IF m.fp_in > 0
          * First check that we have a FoxPro table...
          m.buf=FREAD(m.fp_in,c_buf_size)
          IF (SUBSTR(m.buf,1,1) = CHR(139) OR SUBSTR(m.buf,1,1) = CHR(203);
             OR SUBSTR(m.buf,31,1) != CHR(0) OR SUBSTR(m.buf,32,1) != CHR(0))
              =fclose(m.fp_in)
              DO errormsg WITH c_notfox
              RETURN TO cpzero
          ELSE
              * Now poke the codepage id into byte 29
              =FSEEK(m.fp_in,29)
              =FWRITE(m.fp_in,CHR(m.cpbyte)) 
              =FCLOSE(m.fp_in)
          ENDIF
       ELSE
          DO errormsg WITH c_noopen
          RETURN TO cpzero
       ENDIF
    ELSE
       DO errormsg WITH c_noopen
       RETURN TO cpzero
    ENDIF
ENDIF      


PROCEDURE errormsg
PARAMETER num
WAIT WINDOW error_array[num] NOWAIT